:- module(simple_html_ui, [apply/4], []).

:- use_package(pillow).
:- use_package(functions).
:- use_module(library(hiordlib)).
:- function(arith(false)).

:- use_module(library(terms)).
:- use_module(library(lists)).

:- use_module(term_list_conversion).
:- use_module(search(utils)).

:- multifile fact__names/2.
:- multifile fact__type/1.
:- multifile fact__empty/1.
:- multifile fact__is_empty/1.
:- multifile db__clean/1.
:- multifile db__fact/1.
:- multifile db__assertz/1.

% ---------------------------------------------------------------------------
% Apply CGI Info input to update the state and generate the HtmlView output

:- meta_predicate apply(?, pred(0), ?, ?).
apply(Functors, Hook, Info) := HtmlView :-
	restore(Functors),
	( Info = [] -> true
	; cgi_import(Functors, Info)
	),
        save(Functors),
	Hook,
	restore(Functors),
	HtmlView = ~view(Functors).

% ---------------------------------------------------------------------------
% Restore the state from persistent database

restore([]).
restore([Functor|Functors]) :-
	restore__2(Functor),
	restore(Functors).

restore__2(Functor) :-
	restore_fact__init,
	Functor = Name/Arity,
	functor(Fact, Name, Arity),
	db__local_clean(Fact),
	( db__fact(Fact) ; fact__empty(Fact) ), % db + 1 empty fact
	  restore_fact(Fact),
	  fail.
restore__2(_).

% ---------------------------------------------------------------------------
% Save the state to persistent database

save([]).
save([Functor|Functors]) :-
	save__2(Functor),
	save(Functors).

save__2(Functor) :-
	Functor = Name/Arity,
	functor(Fact, Name, Arity),
	db__clean(Fact),
	db__local_fact(Fact, _Id),
	  \+ fact__is_empty(Fact),
	  db__assertz(Fact),
	  fail.
save__2(_).

% ---------------------------------------------------------------------------
% Apply CGI changes (at this moment, simply restore the state)

cgi_import([], _Info).
cgi_import([Functor|Functors], Info) :-
	cgi_import__2(Info, Functor),
	cgi_import(Functors, Info).

cgi_import__2(Info, Functor) :-
	restore_fact__init,
	Functor = Name/Arity,
	functor(Fact, Name, Arity),
	db__local_clean(Fact),
	cgi_import__3(Info, Functor, 1).

% note: CGI ids and local ids may differ!
cgi_import__3(Info, Functor, Id) :-
	( Fact = ~cgi_import__fact(Info, Functor, Id) ->
	    ( \+ fact__is_empty(Fact) ->
	        restore_fact(Fact)
	    ; true
	    ),
	    Id1 is Id + 1,
	    cgi_import__3(Info, Functor, Id1)
	; % 1 empty fact
	  fact__empty(Fact),
	  restore_fact(Fact)
	).

% Import the fact number Id
cgi_import__fact(Info, Functor, Id) := Fact :- 
	% Check fact functor (fails if no more data is available)
	yes = ~get_form_value(Info, ~functor_id(Functor, Id)),
	% Get types and empty fact 
	Functor = Name/Arity,
	functor(Fact, Name, Arity),
	functor(TypedFact, Name, Arity),
	fact__type(TypedFact),
	% Get the fact arguments
	cgi_import__fact__args(1, Arity, Functor, Id, Info, TypedFact, Fact).

cgi_import__fact__args(I, Arity, _Functor, _Id, _Info, _TypedFact, _Fact) :-
	I > Arity, !.
cgi_import__fact__args(I, Arity, Functor, Id, Info, TypedFact, Fact) :-
	Value0 = ~get_form_value(Info, ~arg_id(I, Functor, Id)),
	( Value0 = '$empty' -> 
	    Value1 = ''
	; Value0 = Value1
	),
	arg(I, TypedFact, Type),
        % Remove blanks around atoms,
        % Doing this  is not the task of arg_decode.
	Value = ~arg_decode(Type, Value1),
	arg(I, Fact, Value),
	I1 is I + 1,
	cgi_import__fact__args(I1, Arity, Functor, Id, Info, TypedFact, Fact).

% ---------------------------------------------------------------------------
% HTML view showing state and operations

view(Functors) :=
	[
	    start_form,
	    ~view__table(Functors),
	    input(submit,[value='Send values']),nl,
	    input(reset,[value='Reset form']),
	    end_form
	].

view__table([]) := [].
view__table([Functor|Functors]) := Xs :-
	Xs = ~append(~view__table__2(Functor), ~view__table(Functors)).

view__table__2(Functor) :=
	[
	    h2(FunctorName),
	    begin(tbody),
	    begin(table),
	    ~view__header(NamedFact),
	    nl,
	    ~view__strs(Functor),
	    end(table),
	    end(tbody)
	] :-
	Functor = Name/Arity,
	functor(NamedFact, Name, Arity),
	fact__names(NamedFact, FunctorName).

% a structure header (names)
view__header(NamedFact) := Row :-
	functor(NamedFact, _, Arity),
	Row = [
		  begin(tr),
		  ~view__header_args(1, Arity, NamedFact),
		  end(tr)
	      ].

view__header_args(I, Arity, _NamedFact) := [] :-
	I > Arity, !.
view__header_args(I, Arity, NamedFact) := [X|Xs] :-
	arg(I, NamedFact, Name),
	X = ~view__header_arg(Name),
	I1 is I + 1,
	Xs = ~view__header_args(I1, Arity, NamedFact).

view__header_arg(Name) :=
	[
	    begin(td), 
	    begin(strong), 
	    Name, 
	    end(strong),
	    end(td)
	].

% a html list of all the functor facts
view__strs(Functor) := ~view__strs__2(Functor, 1).

view__strs__2(Functor, Id) := Rows :-
	( Row = ~view__str(Functor, Id) ->
	    Id1 is Id + 1,
	    Rows = [Row|~view__strs__2(Functor, Id1)]
	; % no more rows
          Rows = []
	).

% a structure
view__str(Functor, Id) := Row :-
	Functor = Name/Arity,
	functor(Fact, Name, Arity),
	db__local_fact(Fact, Id), !,
	functor(TypedFact, Name, Arity),
	fact__type(TypedFact),
	Row = [
		  begin(tr),
		  input(hidden,
		  [
		      name = ~functor_id(Functor, Id),
		      value = yes
		  ]),
		  ~view__args(1, Arity, Functor, Id, TypedFact, Fact),
		  end(tr)
	      ].

view__args(I, Arity, _Functor, _Id, _TypedFact, _Fact) := [] :-
	I > Arity, !.
view__args(I, Arity, Functor, Id, TypedFact, Fact) := [X|Xs] :-
	arg(I, TypedFact, Type),
	arg(I, Fact, Value),
	X = ~view__arg(I, Functor, Id, Type, Value),
	I1 is I + 1,
	Xs = ~view__args(I1, Arity, Functor, Id, TypedFact, Fact).

view__arg(I, Functor, Id, Type, Value) :=
	[
	    begin(td),
	    input(text,
	    [
		name = ~arg_id(I, Functor, Id),
		value = ~arg_encode(Type, Value)
	    ]),
	    end(td)
	].

% ---------------------------------------------------------------------------
% Encoding of terms and term positions (argument ids, etc.)
% ---------------------------------------------------------------------------

% Identification of the Id structure argument
arg_id(I, N/A, Id) := X :-
	atom_number(Id2, Id),
	atom_number(I2, I),
	atom_number(A2, A),
	X = ~atom_concat([N, '_', A2, '_', Id2, '_', I2]).

% Identification of the Id structure functor
functor_id(N/A, Id) := X :-
	atom_number(Id2, Id),
	atom_number(A2, A),
	X = ~atom_concat([N, '_', A2, '_', Id2]).

% Decode an argument
% It should be nice to write:
%
%    [arg_decode(atomic, X)] := ~atom_to_term_list(X).
%
% but for this I need to distinguish functor/data names from predicate
% names explicitly, rather than by the context!  And I'll probably end up
% writing Curry code...
%
arg_decode(atomic, X) := V :- 
	( number(X) -> atom_number(X2, X) ; X2 = X ),
	atom_to_term_list(X2, [V]).
arg_decode(term_list, X) := ~atom_to_term_list(X2) :-
	( number(X) -> atom_number(X2, X) ; X2 = X ).
arg_decode(lowercase_term_list, X) := 
        ~map(~atom_to_term_list(X2), to_lowercase) :-
	( number(X) -> atom_number(X2, X) ; X2 = X ).

% Encode an argument
arg_encode(atomic, X)    := X.
arg_encode(term_list, X) := ~term_list_to_atom(X).
arg_encode(lowercase_term_list, X) := ~term_list_to_atom(X).

% ---------------------------------------------------------------------------
% Internal db facts

restore_fact(Fact) :-
	retract_fact(id(Id)),
	db__local_assertz(Fact, Id),
	Id1 is Id + 1,
	asserta_fact(id(Id1)).

:- data id/1.

restore_fact__init :-
	retractall_fact(id(_)),
	asserta_fact(id(1)).

:- data local_db/2.

db__local_clean(Fact) :- retract_fact(local_db(_, Fact)), fail ; true.
db__local_fact(Fact, Id) :- current_fact(local_db(Id, Fact)).
db__local_assertz(Fact, Id) :- assertz_fact(local_db(Id, Fact)).

